home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / FORTH / FORTHMAC / OLD / TOOLS1 / !Forthmacs.lib.paginate < prev    next >
Text File  |  1996-06-15  |  2KB  |  52 lines
  1. \ Display a file formatted into pages with titles
  2. \
  3. \ (PAGINATE   ( -- )        \ Paginate the file whose descriptor is in ifd
  4. \ "PAGINATE   ( filename -- )    \ Paginate the named file
  5. \ PAGINATE  \ filename  ( -- )    \ Paginate the named file
  6. \ LINES/PAGE  ( -- adr )    \ Variable; # of lines per page
  7. \ LEFT-MARGIN ( -- adr )    \ Variable; # of spaces to indent
  8. \ BOTTOM-MARGIN ( -- adr )    \ Variable; # of lines to leave at the bottom
  9. \
  10. \ The output normally goes to the screen.  To send it to the printer, use:
  11. \    PRINT PAGINATE filename
  12. \ PRINT is defined in PRINTER.FTH
  13.  
  14. decimal
  15. only forth also definitions
  16. needs fgetline extend/filetool.fth
  17. only forth also definitions decimal
  18.  
  19. variable lines/page    66 lines/page !
  20. variable left-margin    4 left-margin !
  21. variable bottom-margin  4 bottom-margin !
  22. variable page#
  23. variable end-reached
  24.  
  25. h# 104 buffer: paginate-filename
  26.  
  27. : .heading    ( -- )
  28.     cr cr
  29.     .today  space  .now
  30.     42 to-column  paginate-filename  ".
  31.     70 to-column  ." Page " page# @ .d   cr
  32.     cr cr ;
  33. : .footing    ( -- )
  34.     lines/page @  #line @  ?do cr loop ;
  35. : 1page        ( -- )
  36.     #line off   .heading
  37.     lines/page @ bottom-margin @ -   #line @
  38.     ?do
  39.         pad  ifd @  fgetline  ( [ str ] flag )
  40.         if  ". cr  else  end-reached on  leave  then
  41.     loop
  42.     .footing   1 page# +! ;
  43. : (paginate    ( -- )    \ Formats an already-open file
  44.     end-reached off   1 page# !
  45.     begin  1page  end-reached @ until
  46.     paginate-filename off    ifd @ fclose ;
  47. : "paginate    ( filename -- )
  48.     dup paginate-filename "copy
  49.     read-open  (paginate ;
  50. : paginate    \ filename  ( -- )
  51.     blword "paginate ;
  52.